perm filename NOIR.F4[MSS,LCS] blob
sn#133838 filedate 1974-11-29 generic text, type T, neo UTF8
00010 C************** NOIR, RJBX, CENTX ***************
00100 SUBROUTINE NOIR(RMINI)
00200 C BLACKS IN NOTES
00400 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
00500 COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
00700 EQUIVALENCE (PRE,IRN(1))
00900 DATA BL/7.5/,BH/6.7/
01000 C ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
01100 IPOS=ROFF(RJB*DIS)
01150 IF(RMINI.LT.1)IPOS=IPOS+1
01200 JPOS=ROFF(CENTR*RHT)
01300 IF(-RMINI.EQ.PRE)GO TO 10
01400 PRE=-RMINI
01950 D=.25*RMINI
02000 B=BH*RMINI*RHT
02010 E=RMINI*DIS
02100 A=BL*E
02200 IC=A
02300 A=A*A
02400 CC K=B+FL
02410 CXX IF(E.LT.1.)E=1.
02420 C TO SHIFT NOTE TO RIGHT A LITTLE
02500 CXX E=E-B/4.
02550 E=-B/4.
02600 K=B
02700 B=B*B
02800 C USES EQUATION FOR ELLIPSE
02900 N=1
03500 NX=2
03600 6 DO 1 J=-K,K
03700 Y=J*J
03900 X=SQRT(A-(A*Y)/B)
04000 L=E-X
04100 M=X+E
04200 C THE TWO SIDES OF THE LINE
04300 IF(N)CALL EXCH(L,M)
04600 IRN(NX)=L
04700 IRN(NX+1)=M
04800 C C IS VERTICLE POS.
04900 NX=NX+2
05000 E=E+D
05100 C E IS TO TILT IT.
05200 1 N=-N
05300 10 CALL PLOT(IPOS,JPOS,3)
05400 N=2
05500 C 1ST LOC. OF ARRAY HAS "PRE"
05550 L=IPOS+IC
05600 DO 11 M=-K,K
05700 J=M+JPOS
05800 CALL PLOT(L+IRN(N),J,2)
05900 CALL PLOT(L+IRN(N+1),J,2)
06000 11 N=N+2
06100 END
06200
06300
07000 CC SUBROUTINE NUMB
07200 CCCC COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
07300 CC DIMENSION ISU(320),R(10,80)
07500 CC COMMON RJB,JA,CENTR,JB,RJC,RJD,RJE,RJQ(17),JC,JQ(19)
07550 CC 1 /STF/RS(8),RSTJC /POSI/STFF(-3/4),JJB,POS/XRN/RN(4000)
07700 CC 1 /DPY/ST(4000),WDS(250),MEDIT,IGO
07800 CC EQUIVALENCE (JF,JQ(3)),(ISU(1),ST(3600)),(R,RN(3001))
08000 CC CALL DPYSET(3,ISU,320)
08100 CC CALL DPYBRT(6)
08200 CC JF=1
08300 CC RA=-100
08600 CCCC RJD=CENTR+100.*RSTJC
08700 CC RJD=18
08800 C RJE=0=1 STANDARD SIZE IS USED.
08820 CCCC POS=STFF(JC)+100.*RSTJC
08900 CC DO 1 K=1,80
09000 CC IF(R(1,K).NE.1.OR.R(2,K).EQ.RA)GO TO 1
09100 CCCC IF(R(3,K).NE.RB)GO TO 2
09400 CC RJB=RHORZ(R(2,K))
09600 CC CALL PNUM
09700 C GOES TO DRAW A NUMBER OVER A NOTE
09800 CC JF=JF+1
09900 CC IF(JF.EQ.10)JF=0
10000 CC1 IF(R(1,K).EQ.0)GO TO 2
10100 CC2 CALL DPYOUT(3)
10200 CC CALL SETPOG(1)
10400 CC END
10450
10500 SUBROUTINE RJBX(R)
10600 COMMON RJB,RJQ(43)/STF/RSTFAC(8),RSTJC
10700 RJB=RJB+R*RSTJC
10800 END
10900
11000 SUBROUTINE CENTX
11100 COMMON A,B,CENTR,D,E,RJD,R(38) /STF/RSTFAC(8),RSTJC
11200 1 /POSI/STFF(8),JJB,POS
11300 CENTR=POS-18.*RSTJC+AMOD(RJD,100.0)*RSTJC*7.
11400 END